home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / env / list-interface.scm < prev    next >
Text File  |  1995-10-13  |  1KB  |  47 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ;  ,open interfaces packages meta-types sort syntactic
  5. ;  ,config scheme
  6.  
  7. (define (list-interface thing)
  8.   (cond ((structure? thing)
  9.      (list-interface-1 (structure-interface thing)
  10.                (lambda (name)
  11.                  (let ((x (structure-lookup thing name #t)))
  12.                    (if (binding? x)
  13.                    (binding-type x)
  14.                    #f)))))
  15.     ((interface? thing)
  16.      (list-interface-1 thing (lambda (name)
  17.                    (interface-ref thing name))))
  18.     (else '?)))
  19.  
  20. (define (list-interface-1 int lookup)
  21.   (let ((l '()))
  22.     (for-each-declaration (lambda (name type)
  23.                 (if (not (memq name l))  ;compound signatures...
  24.                 (set! l (cons name l))))
  25.               int)
  26.     (for-each (lambda (name)
  27.         (write name)
  28.         (display (make-string
  29.               (max 0 (- 25 (string-length
  30.                     (symbol->string name))))
  31.               #\space))
  32.         (write-char #\space)
  33.         (write (careful-type->sexp (lookup name)))    ;( ...)
  34.         (newline))
  35.           (sort-list l (lambda (name1 name2)
  36.                  (string<? (symbol->string name1)
  37.                        (symbol->string name2)))))))
  38.  
  39. (define (careful-type->sexp thing)
  40.   (cond ((not thing) 'undefined)
  41.     ((or (symbol? thing) (null? thing) (number? thing))
  42.      thing)     ;?
  43.     ((pair? thing)    ;e.g. (variable #{Type :value})
  44.      (cons (careful-type->sexp (car thing))
  45.            (careful-type->sexp (cdr thing))))
  46.     (else (type->sexp thing #t))))
  47.